home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue46 / packages / DinoSource.Zip / PaletteTweaking.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-05-12  |  11.5 KB  |  359 lines
  1. unit PaletteTweaking;
  2.  
  3. {$ifdef Ver100} { Delphi 3.0x }
  4.   {$define DelphiLessThan4}
  5. {$endif}
  6. {$ifdef Ver110} { C++ Builder 3.0x }
  7.   {$define DelphiLessThan4}
  8. {$endif}
  9.  
  10. interface
  11.  
  12. procedure Register;
  13.  
  14. implementation
  15.  
  16. uses
  17.   ComCtrls, CommonStuff, ExtCtrls, Menus, SysUtils, Controls,
  18.   Dialogs, Classes, Windows, CommCtrl, Messages, Forms;
  19.  
  20. type
  21.   TPaletteTweaking = class(TObject)
  22.   private
  23.     FTimer: TTimer;
  24.     FMultilineOption,
  25.     FHotTrackOption,
  26.     FButtonsOption: TMenuItem;
  27.     FOldOnResize: TNotifyEvent;
  28.   {$ifdef DelphiLessThan4}
  29.     FToolsOptions: TMenuItem;
  30.     FOldToolsOptionsOnClick: TNotifyEvent
  31.   {$else}
  32.     FTabPanel: TWinControl; //Component palette's parent
  33.     FOriginalTabPanelHeight: Integer; //Component palette's parent's original height
  34.   {$endif}
  35.   protected
  36.   {$ifdef DelphiLessThan4}
  37.     procedure DoConfigurePaletteClick(Sender: TObject);
  38.     procedure DoIDEResize(Sender: TObject);
  39.     procedure UpdateIDESize(OldRowCount: Integer);
  40.   {$else}
  41.     procedure DoTabResize(Sender: TObject);
  42.   {$endif}
  43.     procedure DoPaletteOptions(Sender: TObject);
  44.     procedure DoTimer(Sender: TObject);
  45.     procedure SetMultiLine(Value: Boolean);
  46.     procedure SetHotTrack(Value: Boolean);
  47.     procedure SetButtons(Value: Boolean);
  48.   public
  49.     destructor Destroy; override;
  50.     procedure Setup;
  51.     procedure TidyUp;
  52.   end;
  53.  
  54. resourcestring
  55.   SMultiLine = '&Multiline';   //Multiline toggle option
  56.   SHotTrack = '&Hot tracking'; //Hot-tracking toggle option
  57.   SButtons = '&Buttons instead of tabs'; //Tabs as buttons toggle option
  58.  
  59. const
  60.   SMainFormOnResize = 'WindowResize'; //OnResize handler for main form
  61.   SMsgDlgClass = 'TMessageForm'; //Class name of a MessageDlg form
  62.   //Registry strings
  63.   SRegMultiLine = 'Multi-line Component Palette';
  64.   SRegButtons = 'Tabs As Buttons';
  65.   SRegHotTrack = 'Hot Tracking';
  66. {$ifdef DelphiLessThan4}
  67.   SRegTabHeight = 'Tab Height';
  68.   SToolsOptions = 'ToolsOptionsItem'; //Tools | Environment Options...
  69.   SToolsOptionsOnClick = 'ToolsOptions'; //OnClick handler for above
  70. {$else}
  71.   STabPanel = 'PaletteBar';
  72. {$endif}
  73.  
  74. destructor TPaletteTweaking.Destroy;
  75. begin
  76.   TidyUp;
  77.   inherited Destroy
  78. end;
  79.  
  80. procedure TPaletteTweaking.Setup;
  81. {$ifndef DelphiLessThan4}
  82. var
  83.   Rect: TRect;
  84. {$endif}
  85. begin
  86.   //Make sure there is an options menu - bear in mind
  87.   //that the other options code might not be being used
  88.   Stuff.AddOptionsItem;
  89.   //Set up the hot track, multiline and buttons menu items
  90.   FMultilineOption := NewItem(SMultiLine, 0,
  91.     Stuff.Ini.ReadBool(SRegSection, SRegMultiLine,
  92.       Stuff.FTabControl.MultiLine),
  93.     True, DoPaletteOptions, 0, '');
  94.   FHotTrackOption := NewItem(SHotTrack, 0,
  95.     Stuff.Ini.ReadBool(SRegSection, SRegHotTrack,
  96.       Stuff.FTabControl.HotTrack),
  97.     True, DoPaletteOptions, 0, '');
  98.   FButtonsOption := NewItem(SButtons, 0,
  99.     Stuff.Ini.ReadBool(SRegSection, SRegButtons,
  100.       GetWindowLong(Stuff.FTabControl.Handle, gwl_Style) and
  101.         tcs_Buttons <> 0),
  102.     True, DoPaletteOptions, 0, '');
  103.   //All 3 items use the same handler - Tag distinguishes them
  104.   FMultilineOption.Tag := 1;
  105.   FHotTrackOption.Tag := 2;
  106.   FButtonsOption.Tag := 3;
  107.   //Insert the option menu items
  108.   Stuff.FOptions.Add(FMultilineOption);
  109.   Stuff.FOptions.Add(FHotTrackOption);
  110.   Stuff.FOptions.Add(FButtonsOption);
  111. {$ifdef DelphiLessThan4}
  112.   //To help avoid flickering, we chain into an IDE event handler
  113.   //This may cause problems if someone else chains on to it
  114.   //afterwards, and then we are deleted. The later chainer will
  115.   //be referring to dead code -> AV time
  116.   //Note that we do check to see if the event is already
  117.   //chained and warn the user if so
  118.  
  119.   //Find Tools | Environment Options...
  120.   FToolsOptions := GetComponent(Application.MainForm, SToolsOptions,
  121.     SGenericError + SToolsOptions) as TMenuItem;
  122.   //Save old OnClick handler
  123.   FOldToolsOptionsOnClick := FToolsOptions.OnClick;
  124.   //Warn user if event was already chained
  125.   TestChainedEventHandler(TMethod(FOldToolsOptionsOnClick).Code,
  126.     Application.MainForm.MethodAddress(SToolsOptionsOnClick));
  127.   //Replace Delphi's event handler with our own
  128.   FToolsOptions.OnClick := DoConfigurePaletteClick;
  129.   //Trap IDE form resizing - save old OnResize event
  130.   FOldOnResize := Application.MainForm.OnResize;
  131.   //Warn user if event was already chained
  132.   TestChainedEventHandler(TMethod(FOldOnResize).Code,
  133.     Application.MainForm.MethodAddress(SMainFormOnResize));
  134.   //Replace Delphi's event handler with our own
  135.   Application.MainForm.OnResize := DoResize;
  136. {$else}
  137.   Stuff.FTabControl.Perform(tcm_GetItemRect, 0, Longint(@Rect));
  138.   FTabPanel := GetComponent(Application.MainForm, STabPanel, SGenericError + STabPanel) as TWinControl;
  139.   FOriginalTabPanelHeight := FTabPanel.Height;
  140.   //Trap component palette resizing - save old OnResize event
  141.   FOldOnResize := Stuff.FTabControl.OnResize;
  142.   //Replace Delphi's event handler with our own
  143.   Stuff.FTabControl.OnResize := DoTabResize;
  144. {$endif}
  145.  
  146.   //Set the palette properties as dictated by registry
  147.   //This should really be done here, but the multi-line stuff
  148.   //can't manage to make the IDE window larger when
  149.   //Delphi is starting so we do it in a timer event instead
  150.   FTimer := TTimer.Create(nil);
  151.   FTimer.OnTimer := DoTimer;
  152.   FTimer.Interval := 500;
  153. end;
  154.  
  155. procedure TPaletteTweaking.Tidyup;
  156. begin
  157.   //Save option states
  158.   Stuff.Ini.WriteBool(SRegSection, SRegMultiLine, FMultilineOption.Checked);
  159.   Stuff.Ini.WriteBool(SRegSection, SRegHotTrack, FHotTrackOption.Checked);
  160.   Stuff.Ini.WriteBool(SRegSection, SRegButtons, FButtonsOption.Checked);
  161.   //Tidy up timer
  162.   FTimer.Free;
  163.   //Get rid of customisations from IDE
  164.   SetMultiLine(False);
  165.   SetHotTrack(False);
  166.   SetButtons(False);
  167.   //Unchain the chained event handlers
  168. {$ifdef DelphiLessThan4}
  169.   if Assigned(FToolsOptions) then
  170.     FToolsOptions.OnClick := FOldToolsOptionsOnClick;
  171.   if Assigned(FOldOnResize) then
  172.     Application.MainForm.OnResize := FOldOnResize;
  173. {$endif}
  174.   if Assigned(FOldOnResize) then
  175.     Stuff.FTabControl.OnResize := FOldOnResize;
  176. end;
  177.  
  178. {$ifdef DelphiLessThan4}
  179. procedure TPaletteTweaking.DoConfigurePaletteClick(Sender: TObject);
  180. begin
  181.   //To avoid the excess flicker of the multi-line
  182.   //component palette, we'll try turning it off when
  183.   //it would normally flicker
  184.   SetMultiLine(False);
  185.   //Chain onto old OnClick handler
  186.   if (Sender = FToolsOptions) and
  187.      Assigned(FOldToolsOptionsOnClick) then
  188.     FOldToolsOptionsOnClick(Sender);
  189.   //Set back old value
  190.   SetMultiLine(FMultilineOption.Checked);
  191. end;
  192.  
  193. procedure TPaletteTweaking.DoIDEResize(Sender: TObject);
  194. var
  195.   OldRows: Integer;
  196. begin
  197.   //IDE is being resized - how many tab rows are there right now?
  198.   OldRows := Stuff.FTabControl.Perform(tcm_GetRowCount, 0, 0);
  199.   //Chain onto old OnResize event
  200.   if Assigned(FOldOnResize) then
  201.     FOldOnResize(Sender);
  202.   //Resync component palette's multiline situation
  203.   UpdateIDESize(OldRows);
  204. end;
  205. {$else}
  206. procedure TPaletteTweaking.DoTabResize(Sender: TObject);
  207. var
  208.   AHeight: Integer;
  209. begin
  210.   //This was the part that stopped me releasing this for Delphi 4
  211.   //Eventually I found this idea of using Constraints in the GExperts source
  212.   with Sender as TTabControl do
  213.   begin
  214.     AHeight := Height - (DisplayRect.Bottom - DisplayRect.Top) + 29;
  215.     // When compiled in 4.02, this is incompatible with Delphi 4.00/4.01
  216.     Constraints.MinHeight := AHeight;
  217.     Parent.Constraints.MaxHeight := AHeight;
  218.   end
  219. end;
  220. {$endif}
  221.  
  222. procedure TPaletteTweaking.DoPaletteOptions(Sender: TObject);
  223. begin
  224.   //Toggle options as requested
  225.   with Sender as TMenuItem do
  226.   begin
  227.     Checked := not Checked;
  228.     case Tag of
  229.       1: SetMultiLine(Checked);
  230.       2: SetHotTrack(Checked);
  231.       3: SetButtons(Checked);
  232.     end
  233.   end
  234. end;
  235.  
  236. procedure TPaletteTweaking.DoTimer(Sender: TObject);
  237. begin
  238.   //This triggers shortly after Delphi starts
  239.   //(or whenever this package is initialised)
  240.  
  241.   //Only perform the settings if there is no error
  242.   //message (such as a package load failure). Errors
  243.   //are shown with MessageDlgs which are of type
  244.   //TMessageForm. Let the timer keep running until
  245.   //it's gone so the settings do actually take effect
  246.   if not (Screen.ActiveForm.ClassName = SMsgDlgClass) then
  247.   begin
  248.     FTimer.Enabled := False;
  249.     SetMultiLine(FMultilineOption.Checked);
  250.     SetHotTrack(FHotTrackOption.Checked);
  251.   {$ifndef DelphiLessThan4}
  252.     //Don't need to call this as both the
  253.     //previous routines do it anyway
  254.     SetButtons(FButtonsOption.Checked);
  255.   {$endif}
  256.   end
  257. end;
  258.  
  259. {$ifdef DelphiLessThan4}
  260. procedure TPaletteTweaking.UpdateIDESize(OldRowCount: Integer);
  261.   //Take a number and if necessary, add to it to make it divisible by Inc
  262.   function RoundToNextInc(Current, Inc: Integer): Integer;
  263.   begin
  264.     if Current mod Inc = 0 then
  265.       Result := Current
  266.     else
  267.       Result := Succ(Trunc(Current / Inc)) * Inc
  268.   end;
  269. var
  270.   RowsDelta: Integer;
  271. begin
  272.   //If component palette has decided to have a different number of lines then...
  273.   RowsDelta := Stuff.FTabControl.Perform(tcm_GetRowCount, 0, 0) - OldRowCount;
  274.   //Would do this in Delphi 4+ as well, however need to
  275.   //explicitly reset size on a regular basis, since just
  276.   //changing tab page seems to make component palette grow
  277.   if RowsDelta = 0 then Exit;
  278.   //Need more/less room for the tab rows
  279.   Stuff.FTabControl.Height := Stuff.FTabControl.Height +
  280.     RowsDelta * Stuff.Ini.ReadInteger(SRegSection,
  281.       SRegTabHeight, Stuff.FTabControl.TabHeight);
  282.   //Tell main form to resize according to tab control's height
  283.   with Application.MainForm do
  284.     PostMessage(Handle, wm_Size,
  285.       size_Restored, MakeLong(Width, Height));
  286. end;
  287. {$endif}
  288.  
  289. procedure TPaletteTweaking.SetMultiLine(Value: Boolean);
  290. {$ifdef DelphiLessThan4}
  291. var
  292.   OldRows: Integer;
  293. begin
  294.   OldRows := Stuff.FTabControl.Perform(tcm_GetRowCount, 0, 0);
  295. {$else}
  296. begin
  297. {$endif}
  298.   Stuff.FTabControl.MultiLine := Value;
  299. {$ifdef DelphiLessThan4}
  300.   //If MultiLine property changes, the window gets
  301.   //recreated so we need to set button status back as appropriate
  302.   //since we hacked that option - it ain't a property in Delphi 3
  303.   SetButtons(FButtonsOption.Checked);
  304.   UpdateIDESize(OldRows);
  305. {$endif}
  306. end;
  307.  
  308. procedure TPaletteTweaking.SetHotTrack(Value: Boolean);
  309. begin
  310.   Stuff.FTabControl.HotTrack := Value;
  311. {$ifdef DelphiLessThan4}
  312.   //If HotTrack property changes, the window gets
  313.   //recreated so we need to set buttons back as appropriate
  314.   //since we hacked that option - it ain't a property
  315.   SetButtons(FButtonsOption.Checked)
  316. {$endif}
  317. end;
  318.  
  319. procedure TPaletteTweaking.SetButtons(Value: Boolean);
  320. {$ifdef DelphiLessThan4}
  321. var
  322.   Style: Longint;
  323. begin
  324.   //TTabControl/TPageControl doesn't make buttons
  325.   //facility available as a property in Delphi 3
  326.   Style := GetWindowLong(Stuff.FTabControl.Handle, gwl_Style);
  327.   if Value then
  328.     Style := Style or tcs_Buttons
  329.   else
  330.     Style := Style and not tcs_Buttons;
  331.   //Set desired window style
  332.   SetWindowLong(Stuff.FTabControl.Handle, gwl_Style, Style);
  333. {$else}
  334. const
  335.   BtnStyle: array[Boolean] of TTabStyle = (tsTabs, tsButtons);
  336. begin
  337.   Stuff.FTabControl.Style := BtnStyle[Value]
  338. {$endif}
  339. end;
  340.  
  341. var
  342.   PaletteTweakingObject: TPaletteTweaking;
  343.  
  344. procedure Register;
  345. begin
  346.   PaletteTweakingObject.Setup
  347. end;
  348.  
  349. initialization
  350.   try
  351.     PaletteTweakingObject := TPaletteTweaking.Create
  352.   except
  353.     on E: Exception do
  354.       ShowMessage(SSetupError + ': ' + E.Message)
  355.   end;
  356. finalization
  357.   PaletteTweakingObject.Free
  358. end.
  359.